BBS in a Box 3/BBS in a box - Trilogy III.iso/Files/Prog/T/TurboT folder/HelloTurboTabby.p

Text File | 1989-12-17 | 13.7 KB | 376 lines | [TEXT/TPAS]

unit HelloTurboTabby(1);

{ Written by Pete Johnson, Glassell Park BBS, 213-258-7649                       }


{ ------  ML                                                      }

{ Modified by Michael Lininger, Aurora Borealis BBS, 614-471-6209 }

     { Modifications by Michael Lininger, include :               }
     { Cleanup and port so unit works with Turbo Pacal (Mac)      }

     { • This souce and compiled unit are for use with Turbo Pacal}
     { • Unit has been renamed  'HelloTurboTabby'                 }
     { • In the following comments, replace the word LightSpeed   }
     {   with Turbo                                               }

{ ------ ML                                                       }


{ Source for a LightSpeed Pascal unit which handles the Tabby     }
{ launch.next    file and returns the name of the next application   }
{ to launch in a variable called NextLaunch.                                                          }

{ This source code is being made public in the hopes that it will }
{ lead to more    and better Tabby applications. I ask only that you }
{ credit me with a thanks    if you incorporate any or all of this   }
{ code in an application.                                                     }

{ I have no doubt that this code could be made better. If you     }
{ improve on it,    please share your ideas.                                                          }

{ If you're not using LightSpeed Pascal, you're on your own. I    }
{ don't know    any other Pascal compilers. I'm sure someone other   }
{ than me can help you    if you need to convert this code for Turbo,}
{ TML or Apple's MPW Pascal.                                            }

{ Thanks to Erik Selberg, who has been a real help.                                 }

{ How to use this code:                                                                               }

{  <1> Create a Turbo Pascal Project                                                      }
{  <2> Add the HelloTurboTabby to you units file, internal to     }
{      Turbo, use the Unit's mover application to do this                  }
{  <3> Create your own additional files                                                      }


{ ------ ML                                                       }

{ I have changed the STR resource form 500 to 1511, .ML.          }

{ ------ ML                                                       }


{ You should include an STR resource 1511 in the Project: this    }
{ holds the name    of the default launch.next application (usually  }
{ 'Red Ryder Host').                                                       }

{ Your main program Unit should include the following lines at    }
{ its start:                                                         }

{     uses                                                                                                  }
{       ... any turbo units necessary ... , HelloTurboTabby;                        }

{   End the main procedure of your program as follows:                              }

{    HelloTabby;                                                                                         }
{    if NextLaunch <> '' then                                                                      }
{       LaunchNextAppl                                                  }
{    end.                                                                                                      }


{            ********** History **********                                                         }

{ Modified March 11, 1989, to handle up to 100 events of < 32     }
{ chars apiece.                                                      }
{ Modified April 17,                                              }
{            May  6, 1989, to handle MultiFinder.                                }
{ Modified  June 11, 1989, to use Toolbox file calls.                               }
{ Modified  June 15, 1989, to use Tabby Setup name for 'BBS'            }
{ Modified  July 22, 1989, for additional error checking.                        }

{ ------ ML                                                       }

{ Modified   Dec 16, 1989, for use with Turbo Pacal .ML.          }

{ ------ ML                                                       }



{     Range    checking options turned on, in compiler.                 }
{$R+}

interface

{ Internal Prefab libraries used by HelloTurboTabby               }
uses MemTypes,QuickDraw,OSIntf,ToolIntf;

const
     NULL = #0;
        TAB = #9;
        ENDLINE = #13;
        SPACE = #32;

type
        MyByte = byte;
        OneString = STR255;
        OneStringPtr = ^OneString;
        OneStringHdl = ^OneStringPtr;

var
        FileError: OSErr;
        VRefNum, CurrentResFile, ErrorCode: integer;
        VolName: STR255;
        ErrorFlag: boolean;
        NextAppHandle: StringHandle;

type
     pLaunchStruct = ^LaunchStruct;
        LaunchStruct =
        record
                   pfName: StringPtr;
                      param: INTEGER;
                      LC: packed array[0..1] of CHAR;    { extended parameters:                            }
                      extBlockLen: LONGINT;                          { number of bytes in ext = 6    }
                      fFlags: INTEGER;                                     { Finder file info flags                    }
                      launchFlags: LONGINT;                          { bit 31,30=1 for sublaunch, }
                                             { others reserved            }
         end;

var
        NextLaunch: str255;
        MultiFinder: boolean;

procedure LaunchNextAppl;
procedure HelloTurboTabby;

implementation


{ Procedure #1 ReadConfig - This procedures reads the Config }
{ file to determine if MultiFinder or Finder is being used   }
{ ---------------------------------------------------------- }

procedure ReadConfig;

var
     ConfigRefNum: integer;
           logicalEOF, CharsToSend: longint;
           MFByte: SignedByte;


begin
     MultiFinder := false;
           CharsToSend := 1;
           FileError := FSOpen('Config', vRefNum, ConfigRefNum);
           if FileError = noErr then
              begin
                      FileError := GetEOF(ConfigRefNum, logicalEOF);
                      if (FileError = noErr) and (logicalEOF = 349) then
                         begin
                                 FileError := SetFPos(ConfigRefNum, fsFromStart, 316);
                                 FileError := FSRead(ConfigRefNum, CharsToSend, @MFByte);
                                 if MFByte <> 0 then
                                         MultiFinder := true;
                         end;        {    if (FileError = noErr) and (logicalEOF = 349)    }
              end;    {    if FileError = noErr    }
           FileError := FSClose(ConfigRefNum);
end;



{ Function #1 Launchit - This function does the actual }
{ launch or sublaunch, in cause of MultiFinder.        }
{ Traps 205F, A9F2, 3E80                               }
{ ---------------------------------------------------- }

function Launchit (pLnch: pLaunchStruct): OSErr;

inline
    $205F, $A9F2, $3E80;



{ Procedure #2 LaunchNextAppl - This procedure sets up }
{ the necessary launch flags to be used by Lauchit.    }
{ ---------------------------------------------------- }

procedure LaunchNextAppl;

var
           pMyLaunch: pLaunchStruct;
           myLaunch: LaunchStruct;
           MyPB: CInfoPBRec;

begin { Start Structure LaunchNextAppl }

     with MyPB do { Start Structure MyPB }
              begin
                      ioNamePtr := @NextLaunch;
                   ioVRefNum := vRefNum;
                   ioFDirIndex := 0;
                   ioDirID := 0;
              end;            {    End Structure myPB    }
           FileError := PBGetCatInfo(@MyPB, false);

           pMyLaunch := @myLaunch;
           with pMyLaunch^ do { Start Structure pMyLaunch^ }
              begin
                      pfName := @NextLaunch;
                      param := 0;
                      LC[0] := 'L';
                      LC[1] := 'C';
                      extBlockLen := 6;
                      fFlags := myPB.ioFlFndrInfo.fdFlags;
                      if MultiFinder then
                           LaunchFlags := $C0000000    {    set BOTH high bits for a sublaunch    }
                       else
                              LaunchFlags := $00000000;    {    just launch, then quit    }
     end;                    {    End Structure pMyLaunch^    }
           FileError := Launchit(pMyLaunch);

end; {End Structure LaunchNextAppl }



{ Procedure #3 - HelloTurboTabby.  This procedure looks for a Tabby   }
{ launch.next file. If it's found, it extracts the events, which are  }
{ comma delimited, saves the first one    for the next launch and        }
{ rewrites the file from event #2 to the last    event back to the disk. }

{ If it finds only one event, it kills the launch.next file.                   }

{ If there are no events, it returns the application name contained   }
{ in STR 1511 as str255 NextLaunch, otherwise it uses NextLaunch to   }
{ hold the first entry in the launch.next script.                           }

{ Before returning, it also checks that the NextLaunch application    }
{ exists    by trying to    open it. If the open attempt fails, it returns  }
{ NextLaunch    as an empty string.                                                                          }

procedure HelloTurboTabby;

type
           HundredEvents = array[1..100] of string[32];
           ManyChars = packed array[1..3300] of char;    {    Can hold 100 32-length }
                                                { events, commas and one }
                                                { <CR>.                     }

var
           EventCounter, EventLimit, LNRefNum, LaunchCount: integer;
           LNChar: char;
           BBSByte: SignedByte;
           TheChars: ManyChars;
           Event: HundredEvents;
           Events, ThisEvent, VolName, TempString, BBSName: str255;
           logicalEOF, Quantity, CharIndex: longint;
           CharCount, SetUpRef, SetUpCount: integer;
           fndrInfo: FInfo;

begin { Start Structure HelloTurboTabby }

     FileError := GetVol(@VolName, vRefNum);        { Get volume ref # for }
                                              { default volume.      }
           Events := '';
           for EventCounter := 1 to 100 do
                   Event[EventCounter] := '';

           ThisEvent := '';
           LNChar := chr(255);    {    Dummy value so we can spot }
                         {  this first time through      }
           NextAppHandle := GetString(1511);
           NextLaunch := NextAppHandle^^;
           ReadConfig; {    Read Host's Config File and see }
                 { if we're running MultiFinder.      }
           EventCounter := 1;
           FileError := FSOpen('launch.next', vRefNum, LNRefNum);
           FileError := GetEOF(LNRefNum, logicalEOF);
           if (logicalEOF > 0) and (FileError = NoErr) then
              begin
                      FileError := SetFPos(LNRefNum, fsFromStart, 0);
                      LaunchCount := 0;
                      while (LNChar <> chr(13)) and (LaunchCount <= logicalEOF) do
                         begin { Start Structure LNChar <> chr(13) ... }
                                 while (LNChar <> ',') and (LNChar <> chr(13)) and (LaunchCount <= logicalEOF) do
                                    begin { Start Structure (LNChar <> ',' ... }
                                            if (LNChar <> chr(255)) then
                                               ThisEvent := concat(ThisEvent, LNChar);
                                            LaunchCount := LaunchCount + 1;
                                            Quantity := 1;
                                            FileError := FSRead(LNRefNum, Quantity, @LNChar);
                                            LNChar := chr(ord(LNChar) div 256);
                                     end;            { End Structure (LNChar <> ',' ... }

                                  Event[EventCounter] := ThisEvent;
                                  EventCounter := EventCounter + 1;
                                  ThisEvent := '';
                                  LNChar := chr(255)
          end;            { End Structure (LNChar <> chr(13) ... }

                      FileError := FSClose(LNRefNum);
                      FileError := FSDelete('launch.next', vRefNum);
                      EventLimit := (EventCounter - 2);
                      if EventLimit > 1 then
                         begin { Start Structure EventLimit is > 1 }
                                 FileError := Create('launch.next', vRefNum, 'QUED', 'TEXT');
                                 FileError := FSOpen('launch.next', vRefNum, LNRefNum);
                                 FileError := SetFPos(LNRefNum, fsFromStart, 0);
                                 CharIndex := 0;
                                 for EventCounter := 2 to EventLimit do
                                    begin { Start Structure Launch.Next Counter Loop }
                                            TempString := Event[EventCounter];
                                            for CharCount := 1 to length(TempString) do
                                                    TheChars[CharIndex + CharCount] := TempString[CharCount];

                        CharIndex := CharIndex + length(TempString) + 1;
                                             if EventCounter <> EventLimit then
                                                     TheChars[CharIndex] := ','
                                             else
                                                     TheChars[CharIndex] := ENDLINE;
                                     end; {End Structure Launch.Next Counter loop}

                                  FileError := FSWrite(LNRefNum, CharIndex, @TheChars);
                                  FileError := FSClose(LNRefNum);
                                  FileError := FlushVol(@volName, vRefNum);
                          end; { End Structure EventLimit is > 1 }

                       if EventLimit > 0 then
                               NextLaunch := Event[1];

                       TempString := NextLaunch;
                       UprString(TempString, false);
                       if TempString = 'BBS' then
                          begin { Start Structure Special BBS to Application routine }
                                  FileError := FSOpen('Tabby:Tabby Setup', vRefNum, SetupRef);
                                  if FileError = NoErr then
                                          FileError := GetEOF(SetupRef, logicalEOF);

                                   if (logicalEOF > 0) and (FileError = NoErr) then
                                      begin { Start Structure Get BBS name from Tabby Setup }
                                              FileError := SetFPos(SetupRef, fsFromStart, 0);
                                              BBSName := '';
                                              Quantity := 1;
                                              BBSByte := 0;
                                              SetupCount := 0;
                                              while (BBSByte <> 13) and (SetupCount <= logicalEOF) do
                                                 begin { Start Structure BBSByte <> 13 ... }
                                                         FileError := FSRead(LNRefNum, Quantity, @BBSByte);
                                                         if BBSByte <> 13 then
                                                                 BBSName := concat(BBSName, chr(BBSByte));

                                                 end;        {    End Structure BBSByte <> 13 ... }

                                              FileError := FSClose(SetupRef);
                                              NextLaunch := BBSName;
                                      end        {    End Structure Get BBS name from Tabby Setup    }

                           end;        { End Structure Special BBS to Application routine }

                end        { End Structure EventLimit is > 1 }

             else
                begin { Start Structure Delete Launch.next }
                        FileError := FSClose(LNRefNum);
                        FileError := FSDelete('launch.next', vRefNum)
                end;  { End Structure Delete Launch.next }

         { Is it an application?     }
             FileError := GetFInfo(NextLaunch, vRefNum, fndrInfo);
             if (FileError <> noErr) or (fndrInfo.fdType <> 'APPL') then
                     NextLaunch := ''

end;            { End Structure HelloTurboTabby procedure }

end.            { End Unit Structure }